COVID-19

library(tidyverse)
library(data.table)
library(knitr)
library(kableExtra)
theme_set(theme_bw())
knitr::opts_chunk$set(results = F, echo = T, fig.height=9, fig.width=9, dev='svg')

COVID-19 公開資料

COVID-19 Global Cases by Center for Systems Science and Engineering (CSSE) at John Hopkins

https://systems.jhu.edu/research/public-health/ncov/

base_url <- 
  paste0('https://raw.githubusercontent.com/',
         'CSSEGISandData/COVID-19/master/',
         'csse_covid_19_data/csse_covid_19_time_series/')

filename <- 
  paste0('time_series_covid19_', c('confirmed', 'deaths', 'recovered'), '_global.csv')

url <- paste0(base_url, filename)
url

Confirmed <- 
  url[1] %>% fread() %>%
  rename(country_or_region = `Country/Region`)

資料概覽 (顯示每月 15 號)

varlist= c(1:4, grep('15/21$', names(Confirmed)))

kable(Confirmed[1:50,] %>% select(varlist)) %>%
  kable_classic(lightable_options = 'hover') %>% 
  scroll_box(height = '300px')

Province/State	country_or_region	Lat	Long	1/15/21	2/15/21	3/15/21	4/15/21	5/15/21	6/15/21	7/15/21	8/15/21	9/15/21
	Afghanistan	33.93911	67.709953	53831	55514	55985	57534	63412	93272	137853	152033	154283
	Albania	41.15330	20.168300	66635	93850	118017	129128	131978	132469	132629	135947	159423
	Algeria	28.03390	1.659600	103381	110894	115410	119142	125194	134115	149906	187258	200770
	Andorra	42.50630	1.521800	8946	10538	11289	12641	13510	13828	14239	14924	15108
	Angola	-11.20270	17.873900	18679	20381	21407	23951	30354	36921	40530	44617	51407
	Antigua and Barbuda	17.06080	-61.796400	184	443	963	1209	1241	1263	1267	1397	2304
	Argentina	-38.41610	-63.616700	1783047	2029057	2201886	2629156	3290935	4172742	4719952	5084635	5232358
	Armenia	40.06910	45.038200	163972	169255	178702	206142	220729	223805	226949	234558	250559
Australian Capital Territory	Australia	-35.47350	149.012400	118	118	123	123	124	124	124	152	680
New South Wales	Australia	-33.86880	151.209300	5057	5139	5242	5363	5558	5626	6716	13978	48341
Northern Territory	Australia	-12.46340	130.845600	93	103	105	113	169	175	190	200	204
Queensland	Australia	-27.46980	153.025100	1291	1320	1388	1515	1589	1655	1753	1955	2013
South Australia	Australia	-34.92850	138.600700	593	606	636	678	742	776	825	868	896
Tasmania	Australia	-42.88210	147.327200	234	234	234	234	234	234	234	235	235
Victoria	Australia	-37.81360	144.963100	20417	20475	20483	20492	20544	20676	20748	21166	26942
Western Australia	Australia	-31.95050	115.860500	886	910	926	966	1015	1020	1036	1061	1089
	Austria	47.51620	14.550100	390788	434712	495464	586883	636424	648849	652660	668732	715893
	Azerbaijan	40.14310	47.576900	226549	232197	240671	294211	329371	335264	337801	368002	463326
	Bahamas	25.02588	-78.035889	8021	8311	8765	9505	11024	12225	13274	16141	19795
	Bahrain	26.02750	50.550000	97020	113590	131683	160934	199093	260334	267619	270919	273977
	Bangladesh	23.68500	90.356300	526485	541038	559168	707362	779796	833291	1071774	1418902	1536341
	Barbados	13.19390	-59.543200	1036	2268	3442	3753	3965	4038	4230	4525	6177
	Belarus	53.70980	27.953400	221604	269787	303270	340023	374714	406861	431112	461303	508514
	Belgium	50.83330	4.469936	675089	739488	809861	939309	1030071	1077087	1102069	1149869	1215114
	Belize	17.18990	-88.497600	11529	12175	12383	12529	12714	12989	13644	14847	18143
	Benin	9.30770	2.315800	3413	5039	6501	7611	7995	8140	8244	9065	21450
	Bhutan	27.51420	90.433600	837	866	868	934	1279	1842	2380	2571	2596
	Bolivia	-16.29020	-63.588700	183589	237144	260059	286114	329733	411677	459579	482428	496032
	Bosnia and Herzegovina	43.91590	17.679100	117011	126139	144831	187715	202143	204697	205267	207076	223957
	Botswana	-22.32850	24.684900	17365	25802	34999	44075	49656	61457	86133	136758	165644
	Brazil	-14.23500	-51.925300	8393492	9866710	11519609	13746681	15586534	17533221	19262518	20364099	21034610
	Brunei	4.53530	114.727700	174	184	199	221	232	250	282	723	4566
	Bulgaria	42.73390	25.485800	211503	230747	283194	382761	414041	420654	422797	433234	477161
	Burkina Faso	12.23830	-1.561600	8882	11630	12378	13064	13395	13459	13530	13675	13972
	Burma	21.91620	95.956000	133378	141637	142147	142610	143059	146051	212545	354279	438951
	Burundi	-3.37310	29.918900	1150	1849	2461	3424	4290	5037	5764	9620	14189
	Cabo Verde	16.53880	-23.041800	12776	14761	16120	19780	27951	31704	33180	34397	36816
	Cambodia	11.55000	104.916700	436	479	1325	5218	21834	39464	64611	85448	101443
	Cameroon	3.84800	11.502100	27336	32098	40622	61731	74946	80090	80858	82454	85414
Alberta	Canada	53.93330	-116.576500	115370	129075	138788	166177	217821	230705	232635	238939	273820
British Columbia	Canada	53.72670	-127.647600	60117	72750	88373	116075	138304	146561	148286	155079	176480
Diamond Princess	Canada	0.00000	0.000000	0	0	0	0	0	0	0	0	0
Grand Princess	Canada	0.00000	0.000000	13	13	13	13	13	13	13	13	13
Manitoba	Canada	53.76090	-98.813900	27145	30766	32793	35688	44617	54596	57028	57972	59466
New Brunswick	Canada	46.56530	-66.461900	884	1401	1471	1760	2052	2302	2343	2490	3129
Newfoundland and Labrador	Canada	53.13550	-57.660400	395	704	1012	1036	1184	1381	1433	1447	1551
Northwest Territories	Canada	64.82550	-124.845700	25	43	47	49	121	128	128	131	679
Nova Scotia	Canada	44.68200	-63.744300	1550	1594	1670	1786	4610	5751	5870	5920	6260
Nunavut	Canada	70.29980	-83.107600	266	311	383	396	623	657	657	657	659
Ontario	Canada	51.25380	-85.323200	236127	291451	324715	411346	514907	547959	555146	562656	584531

全球疫情累計確診分布

library(leaflet)
cum = cbind(Confirmed, setNames(select(Confirmed,tail(names(Confirmed),1)),'cum'))

cum %>% leaflet(width = "100%") %>% addTiles() %>% setView(0,0,zoom = 1.5) %>% 
  addCircleMarkers(radius = ~(log2(cum)), color = 'red', fill = T, label = ~paste('N =',cum), popup = ~paste('Country/region:',country_or_region), clusterOptions = markerClusterOptions())

全球疫情累計確診趨勢

全球累計已超過 2.3 億人確診 !

Confirmed_long <-
  Confirmed %>% 
  pivot_longer(-(1:4), names_to = "date", values_to = "confirmed") %>%  
  mutate(date = lubridate::parse_date_time(date, "%m/%d/%y!*")) 

Confirmed_long %>%
  group_by(date) %>% 
  summarise(confirmed = sum(confirmed)) %>% 
  ggplot(aes(as.Date(date), confirmed/1e6)) +
  geom_point() +
  labs(x='Date', y='Confirmed # (per million people)') +
  scale_x_date(date_breaks="3 months", date_labels = "%Y/%m")

各國疫情累計確診趨勢

只觀察累積確診總數，並未考慮各國人口基數

countries = c("US","United Kingdom","China", "Japan", "Korea, South", "Taiwan*","Vietnam")
p=
  Confirmed_long %>%
  filter(country_or_region %in% countries) %>%
  group_by(country_or_region, date) %>% 
  summarise(confirmed = sum(confirmed/1000)) %>% 
  ggplot(aes(y=confirmed, x= as.Date(date), color=country_or_region)) + 
  geom_point() + 
  labs(x='Date', y='Confirmed # (per 1000 people)') +
  #theme(legend.position = "none") +
  scale_x_date(date_breaks="3 months", date_labels = "%Y/%m")

plotly::ggplotly(p,width = 900,height = 900)

各國疫情走勢

可以看到台灣五月底的爆發

Confirmed_long %>%
  filter(country_or_region %in% 
           c("US","United Kingdom","China", "Japan", "Korea, South", "Taiwan*","Vietnam")) %>%
  group_by(country_or_region, date) %>% 
  summarise(confirmed = sum(confirmed/1000)) %>% 
  ggplot(aes(y=confirmed, x= as.Date(date), color=country_or_region)) + 
  geom_point() + 
  facet_grid(country_or_region~., scales = "free") + 
  labs(x='Date', y='Confirmed # (per 1000 people)') +
  theme(legend.position = "none") +
  scale_x_date(date_breaks="3 months", date_labels = "%Y/%m")

各國死亡率

death <- 
  url[2] %>% fread() %>%
  rename(country_or_region = `Country/Region`)

mortality.list = 
function(x){
  round((data.frame(death)[,x]*100/ 
           data.frame(Confirmed)[,x]),2)
}

date.list= 5:ncol(Confirmed)
mortality = lapply(date.list, mortality.list) %>% do.call(cbind,.) %>% data.frame(Confirmed[,1:4],.)
names(mortality)[date.list] = names(Confirmed)[date.list]

last = as.name(names(Confirmed)[ncol(Confirmed)])
m=
  mortality %>% 
  group_by(country_or_region) %>% 
  select(1:4,!!last) %>% 
  filter(!!last!=Inf) %>% 
  summarise(mortality = mean(!!last,na.rm=T)) %>% 
  filter(country_or_region %in% countries) 

可以看到台灣死亡率高於其他國家 (延伸閱讀: https://www.storm.mg/article/3805932)。

台大公衛學院教授詹長權： 有症狀才篩檢的指引、醫療機構重症醫療量能不足、低估確診個案數等原因所致。

library(forcats)
p=
  m %>% 
  mutate(country = fct_reorder(country_or_region, mortality)) %>%
  ggplot() +
  geom_col(aes(y=country, 
               x=mortality, fill = country_or_region)) +
  labs(y='', fill='')
plotly::ggplotly(p,width = 900,height = 600)

Reference:

Dong E, Du H, Gardner L. An interactive web-based dashboard to track COVID-19 in real time. Lancet Infect Dis; published online Feb 19. https://doi.org/10.1016/S1473-3099(20)30120-1.